unit SortedList;

interface

type
  TCompareResult = (crLess, crEqual, crGreat);

  TSortedList<T: Record> = class abstract
  private type
    TPointerArray = array of T;
  public type
    TCompareFunction = reference to function (const Value1, Value2: T): TCompareResult;
  private
    FCount: Integer;
    FCapacity: Integer;
  protected
    FMembers: TPointerArray;
    FCompareFun: TCompareFunction;
  protected
    function BinarySearch(Item: T; var FindPos: Integer): TCompareResult;
  protected
    function Get(Index: Integer): T;
    procedure Grow;
    procedure SetCapacity(NewCapacity: Integer);
  public
    constructor Create(Comparer: TCompareFunction);
    destructor Destroy; override;
  public
    function Add(Item: T): Integer;
    procedure Clear;
    procedure Delete(Index: Integer);

    function IndexOf(Item: T): Integer;
    function Remove(Item: T): Integer;

    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount;
    property Items[Index: Integer]: T read Get;
  end;

implementation

uses
  System.SysUtils;

{ TSortedList<T> }

function TSortedList<T>.Add(Item: T): Integer;
var
  CompareResult: TCompareResult;
begin
  if FCount = FCapacity then
    Grow;

  CompareResult := BinarySearch(Item, Result);
  if CompareResult = crGreat then
  begin
    Result := Result + 1;
  end;

  Move(FMembers[Result], FMembers[Result + 1], (FCount - Result) * SizeOf(T));

  FMembers[Result] := Item;
  Inc(FCount);
end;

function TSortedList<T>.BinarySearch(Item: T;
  var FindPos: Integer): TCompareResult;
var
  MinIdx, MaxIdx: Integer;
begin
  if FCount <= 0 then
  begin
    FindPos := 0;
    Result := crLess;
    Exit;
  end;

  MinIdx := 0;
  MaxIdx := FCount - 1;

  repeat
    FindPos := MinIdx + (MaxIdx - MinIdx) div 2;

    Result := FCompareFun(Item, FMembers[FindPos]);
    case Result of
      crLess:
      begin
        MaxIdx := FindPos - 1;
      end;
      crEqual: break;
      crGreat:
      begin
        MinIdx := FindPos + 1;
      end;
    end;

  until MaxIdx < MinIdx;
end;

procedure TSortedList<T>.Clear;
begin
  FCount := 0;
  SetCapacity(0);
end;

constructor TSortedList<T>.Create(Comparer: TCompareFunction);
begin
  FCompareFun := Comparer;
end;

procedure TSortedList<T>.Delete(Index: Integer);
var
  Temp: T;
begin
  if (Index < 0) or (Index >= FCount) then
    raise Exception.Create('Delte index error : ' + IntToStr(Index));

  Temp := FMembers[Index];
  Dec(FCount);

  Move(FMembers[Index + 1], FMembers[Index], (FCount - Index) * SizeOf(T));
end;

destructor TSortedList<T>.Destroy;
begin
  Clear;
end;

function TSortedList<T>.Get(Index: Integer): T;
begin
  if (Index < 0) or (Index >= FCount) then
    raise Exception.Create('Get index error : ' + IntToStr(Index));
  Result := FMembers[Index];
end;

procedure TSortedList<T>.Grow;
var
  Delta: Integer;
begin
  if FCapacity > 64 then
    Delta := FCapacity div 4
  else
    if FCapacity > 8 then
      Delta := 16
    else
      Delta := 4;
  SetCapacity(FCapacity + Delta);
end;

function TSortedList<T>.IndexOf(Item: T): Integer;
var
  CompareResult: TCompareResult;
begin
  CompareResult := BinarySearch(Item, Result);
  if CompareResult <> crEqual then
    Result := -1;
end;

function TSortedList<T>.Remove(Item: T): Integer;
begin
  Result := IndexOf(Item);
  if Result >= 0 then
  begin
    Delete(Result);
  end;
end;

procedure TSortedList<T>.SetCapacity(NewCapacity: Integer);
begin
  if NewCapacity < FCount then
    raise Exception.Create('List capacity error');

  if NewCapacity <> FCapacity then
  begin
    SetLength(FMembers, NewCapacity);
    FCapacity := NewCapacity;
  end;
end;

end.
